Welcome

Summary

About this Document

This document is an interactive dashboard viewable from most modern internet browsers. The dashboard is a validation and diagnostics tool for CT-RAMP based Activity Based Models. Users can compare model performance against a household survey as part of a validation exercise or compare two model runs for sensitivity testing. All of the data, charts, and maps viewable in this dashboard are embedded directly into the HTML file. An internet connection is necessary for the best user experience, but is not required.

Users may navigate to different areas of the dashboard using the navigation bar at the top of the page, and may interact directly with most tables, charts, and maps.

This document is best viewed using the most recent versions of the following web browsers:

Note: Mozilla Firefox does not correctly render the images in this HTML file.

Summary

Modeling Region

preservea0dfb72d594c094a

Overview

Base Highlights

preserve3acc94e2c24ae784

Base Population

preserved68d1cc131b05f68

Base Households

preserve84b0287736a1afcf

Base Tours

preserve39d5706ad7e3861e

Base Trips

preservecacdf99174950f2b

Base Stops

preserve170abe0c4521fad3

Base VMT

preserved6cc470ca50a8df7

Build Highlights

preservef384b0225913fefa

Build Population

preserve459fe8cce5ff5c11

Build Households

preserve5590e31f8771a691

Build Tours

preserve12ef10ac849baa4b

Build Trips

preserveb3c2a76428aaa162

Build Stops

preserve29560ad32c8473b0

Build VMT

preserved8981078b5dfb739

Chart Column 1

Person Type Distribution

preserve23ab141e69d112bd

Household Size Distribution

preserveb5faccd1f6a9c9b0

Base Highlights2

preservea538b465aefd8d77

Tours per Person

preserve09c5c67d1c35ff8e

Trips per Person

preserve57d36fa8c469d81a

Stops per Person

preserve3f4bd7f351d5041c

Trips per Household

preserve0765b5b84648070c

Build Highlights2

preserveb22defbd97494d6a

Tours per Person

preserve31f0aab251372df2

Trips per Person

preserve1268e7501193b184

Stops per Person

preserve30f4fc73a80d1d55

Trips per Household

preserve45a47fb575b433c5

Long Term Models

Chart Column 1

Auto Ownership

Census source:  ACS 2012-16, All MTC Counties

preservec2b8960b2802e028

Working from home:  ACS 2012-16  vs.  SOLANONAPA

preserve0440719260ac023b

Percentage Working From Home

preserve79f02c0295d3d192

Chart Column 2

Mandatory TLFD

preserve65f21928a35aaaa1

Flows & Tour Lengths

Chart Column 1

County - County Flow of Workers
ACS 2012-16
X Alameda Contra.Costa Marin Napa San.Francisco San.Mateo Santa.Clara Solano Sonoma Total
Alameda 467,011 40,439 4,547 196 100,220 36,690 73,592 1,928 860 725,483
Contra Costa 99,350 291,237 8,918 1,620 61,162 11,740 14,063 8,352 1,084 497,526
Marin 4,067 2,001 80,691 507 29,000 2,681 929 500 4,704 125,080
Napa 1,231 2,037 1,220 52,418 1,885 590 370 4,665 2,689 67,105
San Francisco 23,741 4,101 7,188 253 362,351 49,181 28,446 611 919 476,791
San Mateo 12,978 1,942 1,122 89 84,263 223,390 60,335 294 196 384,609
Santa Clara 39,001 3,378 364 57 15,843 45,416 791,667 306 569 896,601
Solano 9,805 19,831 4,827 12,349 9,398 2,503 1,898 111,625 2,810 175,046
Sonoma 2,239 915 16,533 4,282 6,899 1,054 1,051 912 202,787 236,672
Total 659,423 365,881 125,410 71,771 671,021 373,245 972,351 129,193 216,618 3,584,913

Average Mandatory Tour Lengths
CHTS
Home District Work University School
Marin 0 0.0 0.00
Total 0 31.7 22.17

Chart Column 1

County - County Flow of Workers
SOLANONAPA
X X1 X2 X3 X4 X5 X6 X7 X8 X9 Total
1 399,120 48,440 24,793 17,360 3,113 140 87 187 7,800 501,040
2 95,193 230,880 61,533 13,267 1,700 53 33 47 2,547 405,253
3 14,880 44,340 861,600 45,593 1,173 40 27 7 73 967,733
4 120,013 40,707 69,540 534,607 55,340 1,273 333 107 5,040 826,960
5 53,267 5,913 5,620 109,947 330,540 12,760 2,440 580 10,780 531,847
6 6,153 420 147 7,107 24,800 142,927 12,613 2,307 3,847 200,320
7 887 67 7 947 2,440 6,813 54,447 4,447 1,167 71,220
8 2,467 200 27 380 633 1,080 8,553 225,620 12,887 251,847
9 28,167 2,447 113 4,633 3,893 800 653 4,447 87,053 132,207
Total 720,147 373,413 1,023,380 733,840 423,633 165,887 79,187 237,747 131,193 3,888,427

Average Mandatory Tour Lengths
SOLANONAPA
Home District Work University School
1 6.70 2.53 1.43
2 10.21 7.34 2.74
3 9.19 6.00 2.34
4 11.11 6.62 2.24
5 13.53 10.93 2.76
6 11.29 13.00 2.32
7 9.38 6.84 3.10
8 9.61 8.47 3.35
9 11.22 12.18 3.13
Total 10.18 7.12 2.46

Employment vs Workers

Chart Column 2

Management

Professional

Services

Retail

Manual

Military

Total

Tour Summaries

Chart Column 1

Daily Activity Pattern

preserveabe0a8fdf46f37a8

Percentage of Households with a Joint Tour

preserve3090cee180753e94

Mandatory Tour Frequency

preservea0f4661259228fb6

Chart Column 1

Total Tour Rate (only active Persons)

preserve362c83d9bb55a044

Persons by Individual Non-Mandatory Tours

preserved0e0aa44992c00d3

Joint Tours

Chart Column 1

Joint Tour Frequency

preservec0da241a58f60563

Joint Tour Composition

preserve91dedd402e841e79

Chart Column 1

Joint Tours By Number of Household Members

preservefddd5e6439178fb9

Joint Tours by Household Size

preserveb48cb4e59c96a0a9

Party Size Distribution by Joint Tour Composition

preservef482b06c69a2f926

Destination

Chart Column 1

Non-Mandatory Tour Length Distribution

preserve712b2d4f64b4221c

Average Non-Mandatory Tour Lengths (Miles)

Purpose CHTS SOLANONAPA
Escorting 19.43 3.04
Indi-Maintenance 21.45 5.39
Indi-Discretionary 20.37 5.61
Joint-Maintenance 21.74 5.77
Joint-Discretionary 18.84 6.57
At-Work 19.39 3.63
Total 20.28 4.87

TOD

Chart Column 1

Tour Departure-Arrival Profile

preserve9d5785a9a53a5418

Tour Aggregate Departure-Arrival Profile

preserveb8b5bb6f07cdf76f

Tour Mode

Chart Column 1

Tour Mode Choice

preserve8c2ce6edd7678dd2


Tour Mode Choice

Results of Tour Mode Choice Models, which selects a primary mode for each tour.

Distribution of tours by tour mode and the ratio of autos to drivers in the household.

Chart Column 2

preserveadc613d4dbb5d1d0

Chart Column 3

preserve7008185838cd3ff5

Stop Frequency

Chart Column 1

Stop Frequency - Directional

preserve5f32da1aa834d5cf

Chart Column 1

Stop Frequency - Total

preserve64831b7a815e0b7b

Stop Purpose by Tour Purpose

preserve056903dd352879d2

Location

Chart Column 1

Stop Location - Out of Direction Distance

preserve7a5b9a688f1f66c9

Chart Column 1

Average Out of Direction Distance (Miles)

preservedf534676e8a86eef

TOD

Chart Column 1

Stop & Trip Departure

preserve4d99ad69a05a9beb

Aggregate Stop & Trip Departure

preserve112fcf8afa3dcac1

Trip Mode

Chart Column 1

Trip Mode Choice

The results of the Trip Mode Choice Model, which predicts the mode of each trip on the tour.

Distribution of trips by trip mode and tour mode, which constrains the availability of each trip mode and influences the utility of each available trip mode.

Trip Mode Choice

preserve87086224106b7bdf

Chart Column 2

preserveb9aa1e3b34756f9c

Count vs Volume: All Day

Chart Column 2

Gap Statistics

Count vs Volume: EA

Chart Column 2

EA Gap Statistics

Count vs Volume: AM

Chart Column 2

AM Gap Statistics

Count vs Volume: MD

Chart Column 2

MD Gap Statistics

Count vs Volume: PM

Chart Column 2

PM Gap Statistics

Count vs Volume: EV

Chart Column 2

EV Gap Statistics

MTC vs MARIN

Chart Column 2

Volume Comparison - Daily

Volume Comparison - EA

Volume Comparison - AM

Volume Comparison - MD

Volume Comparison - PM

Volume Comparison - EV

Non-Mandatory Trip Flows

Chart Column 2

TLFD by District

TLFD by District

---
title: "`r paste(BASE_SCENARIO_NAME, 'vs.', BUILD_SCENARIO_NAME, 'Calibration Summary')`"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: fill
    theme: spacelab
    social: menu
    source_code: embed
---

```{r Setup}
opts_knit$set(root.dir = SYSTEM_APP_PATH)
knit_hooks$set(optipng = hook_optipng)
```

```{r setpar}
knitr::opts_knit$set(global.par = TRUE)
```


```{r ggplot_Theme}
theme_db <- theme_bw() + theme(plot.margin = unit(c(10,10,20,10),"pt")) 
```

```{r Helper_Functions}
compare_bar_plotter <- function(base, build, base_name, build_name, xvar, yvar, 
                        xlabel = xvar, ylabel = yvar, position = "dodge", 
                        xrotate = FALSE, yrotate = FALSE, coord_flip = FALSE, 
                        title = "", left_offset = 0, bottom_offset = 0){
  
  base$grp <- base_name
  build$grp <- build_name
  colnames(build) <- colnames(base)
  
  df <- rbind(base, build)
  
  p <- ggplot(df, aes_string(x = xvar, y = yvar)) + 
    geom_bar(stat = "identity", aes(fill = grp), position = position) + 
    xlab(xlabel) + ylab(ylabel) +
    labs(fill = "") + 
    ggtitle(title) + 
    theme(axis.text.x=element_text(angle=50, size=1, vjust=0.5)) + 
    theme(axis.text.y=element_text(angle=50, size=1, vjust=0.5)) + 
    theme_bw()
  
  if (xrotate) {
    p <- p + theme(axis.text.x = element_text(angle = 45, hjust = 1))
  }
  if (yrotate) {
    p <- p + theme(axis.text.y = element_text(angle = 45, hjust = 1))
  }
  if (coord_flip) {
    p <- p + coord_flip()
  }
  
 
  p <- plotly_build(p)
  p$layout$margin$l <- p$layout$margin$l+left_offset
  p$layout$margin$b <- p$layout$margin$b+bottom_offset
  return(p)
  
}

# This function combines two dataframes and returns a data frame with standard field names
# The field names in the two dataframes should be same and should be same as the variable
# names passed to the function
# input parameter - dataframe1, dataframe2, x variable, list of y variables
# renames x and y variables in standard form - xvar, (yvar1, yvar2),...
# Y variables are named in pairs - (yvar1, yvar2), (yvar3, yvar4), ....
# yvar1, yvar3, .. correspond to first dataframe and yvar2, yvar4, .. correspond to second dataframe
# computes proportions for each  y variable variable
get_standardDF <- function(data_df1, data_df2, x, y, grp = "", shared = F){
  
  #data_df1=base_df
  #data_df2=build_df
  #x="id"
  #y = c("freq_out", "freq_inb")
  #grp = "purpose"
  #shared = T
  #
  # create ID variable to join base and build data
  if(!shared){
    ev1 <- paste("data_df1$id_var <- data_df1$", x, sep = "")
    ev2 <- paste("data_df2$id_var <- data_df2$", x, sep = "")
    eval(parse(text = ev1))
    eval(parse(text = ev2))
  }else{
    if(grp==""){
      stop("group variable not specified")
    }else{
      ev1 <- paste("data_df1$id_var <- paste(data_df1$", grp, ", data_df1$", x, ', sep = "")', sep = "")
      ev2 <- paste("data_df2$id_var <- paste(data_df2$", grp, ", data_df2$", x, ', sep = "")', sep = "")
      eval(parse(text = ev1))
      eval(parse(text = ev2))
    }
  }
  
  data_df <- data_df1
  
  # rename variables to standard names
  names(data_df)[names(data_df) == x] <- 'xvar'
  if(shared){
    if(grp==""){
      stop("group variable not specified")
    }else{
      names(data_df)[names(data_df) == grp] <- 'grp_var'
    }
  }
  
  for(i in seq(from=1, to=length(y))){
    start_pos <- i*2-1
    yvar1 <- paste('yvar', start_pos, sep = "")
    yvar2 <- paste('yvar', start_pos+1, sep = "")
    names(data_df)[names(data_df) == y[[i]]] <- paste('yvar', start_pos, sep = "")
    eval_expr <- paste("data_df$", yvar2, " <- data_df2$", y[[i]], "[match(data_df$id_var, data_df2$id_var)]", sep = "")
    eval(parse(text = eval_expr))
  }
  data_df[is.na(data_df)] <- 0
  
  #data_df$grp_var <- as.character(data_df$grp_var)
  
  # compute proportions for y variables
  for(i in seq(from=1, to=length(y))){
    start_pos <- i*2-1
    prop_var1 <- paste('prop', start_pos, sep = "")
    y_var1    <- paste('yvar', start_pos, sep = "")
    prop_var2 <- paste('prop', start_pos+1, sep = "")
    y_var2    <- paste('yvar', start_pos+1, sep = "")
    if(shared){
      if(grp==""){
        stop("group variable not specified")
      }else{
        eval_expr1 <- paste("data_df <- data_df %>% group_by(grp_var) %>% mutate(", prop_var1, " = prop.table(", y_var1, "))", sep = "")
        eval_expr2 <- paste("data_df <- data_df %>% group_by(grp_var) %>% mutate(", prop_var2, " = prop.table(", y_var2, "))", sep = "")
      }
    }else{
      eval_expr1 <- paste("data_df <- data_df %>% mutate(", prop_var1, " = prop.table(", y_var1, "))", sep = "")
      eval_expr2 <- paste("data_df <- data_df %>% mutate(", prop_var2, " = prop.table(", y_var2, "))", sep = "")
    }
    
    eval(parse(text = eval_expr1))
    eval(parse(text = eval_expr2))
  }
  
  # set all NAs to zero
  data_df[is.na(data_df)] <- 0
  
  if(!shared){
    return(data_df)
  }else{
    data_sd <- SharedData$new(data_df, ~grp_var)
    return(data_sd)
  }
}

# This function returns a SharedData object for creating comparison density plots
# input parameter - dataframe1, dataframe2, x variable, list of y variables, 
# grouping variable, names of each run
# The function expects same field names across both dataframes
# renames x and y variables in standard form - xvar, yvar1, yvar2,...
# computes proportions for each  y variable variable for each group and run
# combines two dataframe and adds a run identifier
get_sharedData <- function(data_df1, data_df2, run1_name = 'base', run2_name = 'build', 
                           x, y, grp){
  
  # rename variables to standard names
  names(data_df1)[names(data_df1) == x] <- 'xvar'
  names(data_df1)[names(data_df1) == grp] <- 'grp_var'
  for(i in 1:length(y)){
    names(data_df1)[names(data_df1) == y[[i]]] <- paste('yvar', i, sep = "")
  }
  
  names(data_df2)[names(data_df2) == x] <- 'xvar'
  names(data_df2)[names(data_df2) == grp] <- 'grp_var'
  for(i in 1:length(y)){
    names(data_df2)[names(data_df2) == y[[i]]] <- paste('yvar', i, sep = "")
  }
  
  # compute proportions for y variables
  data_df1 <- group_by(data_df1, grp_var)
  for(i in 1:length(y)){
    prop_var <- paste('prop', i, sep = "")
    y_var    <- paste('yvar', i, sep = "")
    eval_expr <- paste("data_df1 <- data_df1 %>% mutate(", prop_var, " = prop.table(", y_var, "))", sep = "")
    eval(parse(text = eval_expr))
  }
  
  data_df2 <- group_by(data_df2, grp_var)
  for(i in 1:length(y)){
    prop_var <- paste('prop', i, sep = "")
    y_var    <- paste('yvar', i, sep = "")
    eval_expr <- paste("data_df2 <- data_df2 %>% mutate(", prop_var, " = prop.table(", y_var, "))", sep = "")
    eval(parse(text = eval_expr))
  }
  
  # add run identifiers
  data_df1$run <- run1_name
  data_df2$run <- run2_name
  
  # combine dataframes
  data_df <- rbind(data_df1, data_df2)
  
  # set all NAs to zero
  data_df[is.na(data_df)] <- 0
  
  data_sd <- SharedData$new(data_df, ~grp_var)
  return(data_sd)
}

# This function returns bar plot for a given X-Y data frame
# The function expects the data frame columns to be named as
# xvar, yvar1, yvar2...
# function plots only two series at a time
# which two y series to plot is determined by the index variable
# index==1 :- yvar1, yvar2, index==2 :- yvar,3,4 and so on
# names of series to be plotted should also be passed as a list argument
# number of elements in names list determines the number of series to be added 
plotly_bar_plotter <- function(data, type = 'bar', xlabel = "", ylabel = "", percent = FALSE,
                               title = "", height = 0, width = 0, ynames = c(""), left_offset = 0, 
                               bottom_offset = 0, tickformat = "", hoverformat = "", tickangle = 0, index = 1, tickvals = c(), ticktext = c()){
  #initial setup
  start_pos <- 2*index - 1
  exp_tickvals <- ifelse(length(tickvals)>0, ', tickvals = tickvals', "")
  exp_ticktext <- ifelse(length(ticktext)>0, ', ticktext = ticktext', "")
  
  #generate plot
  if(!percent){
    ylab <- ifelse(ylabel=="", "Percent", ylabel)
    hformat <- ifelse(hoverformat=="", '.1f', hoverformat)
    eval_expr <- paste("p <- plot_ly(data, x = ~xvar, y = ~yvar", start_pos, ", type = type, name = ynames[[1]]) %>% ", 
                       "add_trace(y = ~yvar", start_pos+1, ", name = ynames[[2]]) %>% ", 
                       "layout(yaxis = list(hoverformat = hformat, title = ylab, tickformat = tickformat), xaxis = list(title = xlabel, tickangle = tickangle", exp_tickvals, exp_ticktext, "), barmode = 'group')", sep = "")
    eval(parse(text = eval_expr))
  }else{
    ylab <- ifelse(ylabel=="", "Frequency", ylabel)
    hformat <- ifelse(hoverformat=="", '.1%', hoverformat)
    eval_expr <- paste("p <- plot_ly(data, x = ~xvar, y = ~prop", start_pos, ", type = type, name = ynames[[1]]) %>% ", 
                       "add_trace(y = ~prop", start_pos+1, ", name = ynames[[2]]) %>% ", 
                       "layout(yaxis = list(hoverformat = hformat, title = ylab, tickformat = '%'), xaxis = list(title = xlabel, tickangle = tickangle", exp_tickvals, exp_ticktext,"), barmode = 'group')", sep = "")
    eval(parse(text = eval_expr))
  }
  
  p$x$layout$height <- height
  p$x$layout$width <- width
  p$x$layout$margin$b <- p$x$layout$margin$b + bottom_offset
  p$x$layout$margin$l <- p$x$layout$margin$l + left_offset
  return(p)
}

# This function returns a spline plot with fill for a gievn X-Y dataframe
# The function expects the data frame columns to be named as
# x = ~xvar, y = (~yvar1 or prop1),  (~yvar2 or prop2) adn so on (Frequency or Percent), 
# which y to use is determined by index parameter (one, two or three)
# and variable differentiating runs as ~run
# The function currebtly plots only one Y variables for each run
plotly_density_plotter <- function(data_df, index = "one", colors=c("orange", "steelblue"), fill = 'tozeroy', 
                                   title = "", xlabel = "", ylabel = "", percent = T, alpha = 0.7, tickvals, ticktext, tickangle = 0,
                                   height=400, left_offset = 0, bottom_offset = 0, shape = 'spline', legend = T){
  ##standardize data frame
  #names(data_df)[names(data_df)==xvar]     <- 'xvar'
  #names(data_df)[names(data_df)==yvar]     <- 'yvar1'
  #names(data_df)[names(data_df)==prop_var] <- 'prop1'
  #names(data_df)[names(data_df)==grp]      <- 'run'
  
  # prepare plot using standardized dataframe
  if(percent){
    ylab <- ifelse(ylabel=="", "Percent", ylabel)
    
    p <- switch(index, 
                "one" = plot_ly(data=data_df,x = ~xvar, y = ~prop1, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab, tickformat = "%"), showlegend = legend),
                "two" = plot_ly(data=data_df,x = ~xvar, y = ~prop2, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab, tickformat = "%"), showlegend = legend),
                "three" = plot_ly(data=data_df,x = ~xvar, y = ~prop3, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab, tickformat = "%"), showlegend = legend)
                )
    
  }else{
    ylab <- ifelse(ylabel=="", "Frequency", ylabel)
    
    p <- switch(index,
                "one" = plot_ly(data=data_df,x = ~xvar, y = ~yvar1, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab), showlegend = legend),
                "two" = plot_ly(data=data_df,x = ~xvar, y = ~yvar2, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab), showlegend = legend),
                "three" = plot_ly(data=data_df,x = ~xvar, y = ~yvar3, colors=c("steelblue", "orange"), color = ~run, fill=fill) %>%
                  add_lines(name="",alpha=alpha, line = list(shape = shape)) %>%
                  layout(title = "",xaxis = list(title=xlabel, tickvals = tickvals, ticktext = ticktext, tickangle = tickangle), yaxis = list(title=ylab), showlegend = legend)
                )
    
    #p <- plot_ly(data=data_df,x = ~xvar, y = ~yvar1, colors=c("steelblue", "orange"), color = ~run, height=400, fill=fill) %>%
    #add_lines(name="",alpha=alpha, line = list(shape = shape)) %>% 
    #layout(title = "",xaxis = list(title=xlabel), yaxis = list(title=ylab))
  }
  
  p$x$layout$height <- height
  p$x$layout$margin$b <- p$x$layout$margin$b + bottom_offset
  p$x$layout$margin$l <- p$x$layout$margin$l + left_offset
  return(p)
}

# This function returns a pie chart
# Input is a 2 column data frame with a label variable and a value variable
plotly_pie_chart <- function(data, label_var, value_var, title = "", 
                               height = 0, width = 0, left_offset = 0,bottom_offset = 0, top_offset = 0, shared = F){
  
  colors <- c('rgb(211,94,96)', 'rgb(128,133,133)', 'rgb(144,103,167)', 'rgb(171,104,87)', 'rgb(114,147,203)')
  
  if(!shared){
    names(data)[names(data)==label_var] <- 'label_var'
    names(data)[names(data)==value_var] <- 'value_var'
    
    p <- plot_ly(data, labels = ~label_var, values = ~value_var, type = 'pie',
          textposition = 'outside',
          textinfo = 'label+percent',
          insidetextfont = list(color = '#FFFFFF'),
          marker = list(colors = colors,
                        line = list(color = '#FFFFFF', width = 2)),
          showlegend = FALSE, 
          sort = FALSE) %>%
    layout(title = title,
           xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
           yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
  }else{
    eval_expr <- paste("p <- plot_ly(data, labels = ~", label_var, ", values = ~", value_var, ", type = 'pie',
          textposition = 'outside',
          textinfo = 'label+percent',
          insidetextfont = list(color = '#FFFFFF'),
          marker = list(colors = colors,
                        line = list(color = '#FFFFFF', width = 2)),
          showlegend = FALSE, 
          sort = FALSE) %>%
    layout(title = title,
           xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
           yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))", sep = "")
    
    eval(parse(text = eval_expr))
  }
  
  
  p$x$layout$height <- height
  p$x$layout$width <- width
  p$x$layout$margin$b <- p$x$layout$margin$b + bottom_offset
  p$x$layout$margin$l <- p$x$layout$margin$l + left_offset
  p$x$layout$margin$t <- p$x$layout$margin$t + top_offset
  return(p)
}

lm_eqn <- function(df){
    m <- lm(y ~ x - 1, df);
    eq <- paste("Y = ", format(coef(m)[1], digits = 2), " * X , ", " r2 = ", format(summary(m)$r.squared, digits = 3), sep = "")
    return(eq)
}

```

Welcome
============================================

Summary {data-width=150}
--------------------------------------------

### About this Document

This document is an interactive dashboard viewable from most modern internet browsers. The dashboard is a validation and diagnostics tool for CT-RAMP based Activity Based Models. Users can compare model performance against a household survey as part of a validation exercise or compare two model runs for sensitivity testing. All of the data, charts, and maps viewable in this dashboard are embedded directly into the HTML file. An internet connection is necessary for the best user experience, but is not required.

Users may navigate to different areas of the dashboard using the navigation bar at the top of the page, and may interact directly with most tables, charts, and maps.

This document is best viewed using the most recent versions of the following web browsers:

* [Google Chrome](https://www.google.com/chrome/browser/desktop/)
* [Microsoft Internet Explorer](https://www.microsoft.com/en-us/download/internet-explorer.aspx)

Note: Mozilla Firefox does not correctly render the images in this HTML file.

Summary {data-width=600}
--------------------------------------------

### Modeling Region
```{r model_region}
bins <- c(0, 10, 20, 50, 100, 200, 500, 1000, Inf)
pal <- colorBin("YlOrRd", domain = zone_shp$HH, bins = bins)

#m <- leaflet(data = zone_shp)%>% 
#  addTiles() %>% 
#  addProviderTiles(providers$OpenStreetMap, group = "Background Map") %>%
#  addLayersControl(
#    overlayGroups = "Background Map", options = layersControlOptions(collapsed = FALSE)
#  ) %>%
#  addPolygons(weight = 0.5, opacity = 1)
#m
m <- leaflet(data = zone_shp)%>% 
  addTiles() %>% 
  addProviderTiles(providers$OpenStreetMap, group = "Background Map") %>%
  addLayersControl(
    overlayGroups = "Background Map", options = layersControlOptions(collapsed = FALSE)
  ) 
m

#  
```


Overview
============================================

Base Highlights {data-width=90}
--------------------------------------------

### 

```{r Run_Date1_ValueBox}
sample_rate <- ifelse(IS_BASE_SURVEY=="Yes", "", as.character(BASE_SAMPLE_RATE*100))
valueBox(BASE_SCENARIO_NAME, paste("Sample Rate: ", sample_rate, "%", sep = ""), color = "DarkOrange")
base_pos <- which(base_csv_names=="totals")
base_df <- base_data[[base_pos]]
```

### Base Population
```{r Population1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_population"]/BASE_SAMPLE_RATE), big.mark = ","), "Population", icon = "ion-ios-people")
```

### Base Households
```{r Household1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_households"]/BASE_SAMPLE_RATE), big.mark = ","), "Households", icon = "glyphicon glyphicon-home")
```

### Base Tours
```{r Tours1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_tours"]/BASE_SAMPLE_RATE), big.mark = ","), "Total Tours", icon = "ion-refresh")
```

### Base Trips
```{r Trips1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_trips"]/BASE_SAMPLE_RATE), big.mark = ","), "Total Trips", icon = "ion-loop")
```

### Base Stops
```{r Stops1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_stops"]/BASE_SAMPLE_RATE), big.mark = ","), "Total Stops", icon = "ion-ios-location")
```

### Base VMT
```{r VMT1_ValueBox}
valueBox(prettyNum(round(base_df$value[base_df$name=="total_vmt"]/BASE_SAMPLE_RATE), big.mark = ","), "Total VMT", icon = "ion-android-car")
```



Build Highlights {data-width=90}
--------------------------------------------

### 

```{r Run_Date2_ValueBox}
valueBox(BUILD_SCENARIO_NAME, paste("Sample Rate: ", BUILD_SAMPLE_RATE*100, "%", sep = ""), color = "DarkOrange")
build_pos <- which(build_csv_names=="totals")
build_df <- build_data[[build_pos]]
```

### Build Population
```{r Population2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_population"]/BUILD_SAMPLE_RATE), big.mark = ","), "Population", icon = "ion-ios-people")
```

### Build Households
```{r Household2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_households"]/BUILD_SAMPLE_RATE), big.mark = ","), "Households", icon = "glyphicon glyphicon-home")
```

### Build Tours
```{r Tours2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_tours"]/BUILD_SAMPLE_RATE), big.mark = ","), "Total Tours", icon = "ion-refresh")
```

### Build Trips
```{r Trips2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_trips"]/BUILD_SAMPLE_RATE), big.mark = ","), "Total Trips", icon = "ion-loop")
```

### Build Stops
```{r Stops2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_stops"]/BUILD_SAMPLE_RATE), big.mark = ","), "Total Stops", icon = "ion-ios-location")
```

### Build VMT
```{r VMT2_ValueBox}
valueBox(prettyNum(round(build_df$value[build_df$name=="total_vmt"]/BUILD_SAMPLE_RATE), big.mark = ","), "Total VMT", icon = "ion-android-car")
```


Chart Column 1 {data-width=275}
--------------------------------------------
### Person Type Distribution
```{r Chart_Person_Type}
base_pos <- which(base_csv_names=="pertypeDistbn")
base_df <- base_data[[base_pos]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)
build_pos <- which(build_csv_names=="pertypeDistbn")
build_df <- build_data[[build_pos]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "PERNAME", y = c("freq"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "Person Type", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, bottom_offset = 60, tickangle = -30)
p

```

### Household Size Distribution
```{r Chart_HHSize}
base_pos <- which(base_csv_names=="hhSizeDist")
base_df <- base_data[[base_pos]]
build_pos <- which(build_csv_names=="hhSizeDist")
build_df <- build_data[[build_pos]]

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "HHSIZE", y = c("freq"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "HH Size", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)
p

```

Base Highlights2 {data-width=90}
--------------------------------------------

### 

```{r Run_Date3_ValueBox}
valueBox(BASE_SCENARIO_NAME, "", color = "DarkOrange")
base_pos <- which(base_csv_names=="totals")
base_df <- base_data[[base_pos]]
```


### Tours per Person
```{r TourRate3_Gauge}
rate <- base_df$value[base_df$name=="total_tours"]/base_df$value[base_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 2, gaugeSectors(danger = c(0,2), colors = c("Green", "Green", "Green")))
```

### Trips per Person
```{r TripRate3_Gauge}
rate <- base_df$value[base_df$name=="total_trips"]/base_df$value[base_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 5, gaugeSectors(danger = c(0,5), colors = c("Green", "Green", "Green")))
```

### Stops per Person
```{r StopRate3_Gauge}
rate <- base_df$value[base_df$name=="total_stops"]/base_df$value[base_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 2, gaugeSectors(danger = c(0,2), colors = c("Green", "Green", "Green")))
```

### Trips per Household
```{r TRate3_Gauge}
rate <- base_df$value[base_df$name=="total_trips"]/base_df$value[base_df$name=="total_households"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 15, gaugeSectors(danger = c(0,15), colors = c("Green", "Green", "Green")))
```


Build Highlights2 {data-width=90}
--------------------------------------------

### 

```{r Run_Date4_ValueBox}
valueBox(BUILD_SCENARIO_NAME, "", color = "DarkOrange")
build_pos <- which(build_csv_names=="totals")
build_df <- build_data[[build_pos]]
```


### Tours per Person
```{r TourRate4_Gauge}
rate <- build_df$value[build_df$name=="total_tours"]/build_df$value[build_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 2, gaugeSectors(danger =  c(0,2), colors = c("Green", "Green", "Green")))
```

### Trips per Person
```{r TripRate4_Gauge}
rate <- build_df$value[build_df$name=="total_trips"]/build_df$value[build_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 5, gaugeSectors(danger = c(0,5), colors = c("Green", "Green", "Green")))
```

### Stops per Person
```{r StopRate4_Gauge}
rate <- build_df$value[build_df$name=="total_stops"]/build_df$value[build_df$name=="total_population"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 2, gaugeSectors(danger = c(0,2), colors = c("Green", "Green", "Green")))
```

### Trips per Household
```{r TRate4_Gauge}
rate <- build_df$value[build_df$name=="total_trips"]/build_df$value[build_df$name=="total_households"]
gauge(prettyNum(round(rate, 2), big.mark = ","), min = 0, max = 15, gaugeSectors(danger = c(0,15), colors = c("Green", "Green", "Green")))
```


Long Term Models{data-navmenu="Long Term"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------


**Auto Ownership**

Results of household auto ownership model, which predicts number of vehicles per household.

**Work from Home**

Result of work from home choice model, which predicts whether workers have usual work place at home. These workers do not generate work tours, but can have non-mandatory tours.

**Mandatory TLFD**

Results of work and school location choice models.

Distribution of workers by distance between home and usual work place, and students by distance between home and school location.

Chart Column 1 {data-width=200}
--------------------------------------------
### Auto Ownership{data-height=265}
```{r Chart_Auto_Ownership}
if(IS_BASE_SURVEY=="Yes"){
  cat("Census source: ", AO_CENSUS_LONG)
  base_df <- base_data[[which(base_csv_names=="autoOwnershipCensus")]]

}else{
  base_df <- base_data[[which(base_csv_names=="autoOwnership")]]
}

build_df <- build_data[[which(build_csv_names=="autoOwnership")]]

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "HHVEH", y = c("freq"))

p <- plotly_bar_plotter(data = std_DF, xlabel = "Number of Vehicles", ylabel = "Percent", ynames = c(AO_CENSUS_SHORT, BUILD_SCENARIO_NAME), percent = T, height = 225)
p
```

### {data-height=140}
```{r Gauge_WFH1}
cat("Working from home: ", WFH_Source, " vs. ", BUILD_SCENARIO_NAME)

if(IS_BASE_SURVEY=="Yes"){
  base_df <- base_data[[which(base_csv_names=="wfh_summaryCensus")]]
}else{
  base_df <- base_data[[which(base_csv_names=="wfh_summary")]]
}

rate <- base_df$WFH[base_df$District=="Total"]/base_df$Workers[base_df$District=="Total"]
gauge1 <- gauge(round(rate*100, 1), min = 0, max = 100, symbol = '%', gaugeSectors(danger =  c(0,1), colors = c("Green", "Green", "Green")))

build_df <- build_data[[which(build_csv_names=="wfh_summary")]]
rate <- build_df$WFH[build_df$District=="Total"]/build_df$Workers[build_df$District=="Total"]
gauge2 <- gauge(round(rate*100, 1), min = 0, max = 100, symbol = '%', gaugeSectors(danger =  c(0,1), colors = c("Green", "Green", "Green")))

bscols(widths = c(6,6),
  gauge1,
  gauge2
)

```

### Percentage Working From Home{data-height=250}
```{r Chart_WFH}
if(IS_BASE_SURVEY=="Yes"){
  base_df <- base_data[[which(base_csv_names=="wfh_summaryCensus")]]
}else{
  base_df <- base_data[[which(base_csv_names=="wfh_summary")]]
}
base_df$share <- base_df$WFH/base_df$Workers

build_df <- build_data[[which(build_csv_names=="wfh_summary")]]
build_df$share <- build_df$WFH/build_df$Workers

std_DF <- cbind(base_df[,c("District", "share")], build_df[,c("share")])
colnames(std_DF) <- c("xvar", "prop1", "prop2")

p <- plotly_bar_plotter(data = std_DF, xlabel = "District", ylabel = "Percent WFH", ynames = c(WFH_Source, BUILD_SCENARIO_NAME), percent = T, height = 275, tickangle = -320, bottom_offset = 25)
p

```



Chart Column 2 {data-width=350}
--------------------------------------------


### Mandatory TLFD{data-height=475}
```{r mandatoryTLFD}
base_df1 <- base_data[[which(base_csv_names=="workTLFD")]]
base_df1 <- melt(base_df1, id = c("distbin"))

base_df2 <- base_data[[which(base_csv_names=="univTLFD")]]
base_df2 <- melt(base_df2, id = c("distbin"))

base_df3 <- base_data[[which(base_csv_names=="schlTLFD")]]
base_df3 <- melt(base_df3, id = c("distbin"))

base_df <- cbind(base_df1, base_df2$value, base_df3$value)
colnames(base_df) <- c("distbin","variable","value1","value2","value3")

build_df1 <- build_data[[which(build_csv_names=="workTLFD")]]
build_df1 <- melt(build_df1, id = c("distbin"))

build_df2 <- build_data[[which(build_csv_names=="univTLFD")]]
build_df2 <- melt(build_df2, id = c("distbin"))

build_df3 <- build_data[[which(build_csv_names=="schlTLFD")]]
build_df3 <- melt(build_df3, id = c("distbin"))

build_df <- cbind(build_df1, build_df2$value, build_df3$value)
colnames(build_df) <- c("distbin","variable","value1","value2","value3")

sd.purpose <- get_sharedData(data_df1 = build_df, data_df2 = base_df, run1_name = BUILD_SCENARIO_NAME, 
                             run2_name = BASE_SCENARIO_NAME, x = "distbin", y = c("value1", "value2", "value3"), grp = "variable")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Miles to Work", percent = T, tickvals = seq(1,50,5), ticktext = seq(0,50,5), height = 240)
p2 <- plotly_density_plotter(sd.purpose, index = "two", xlabel = "Miles to University", percent = T, tickvals = seq(1,50,5), ticktext = seq(0,50,5), height = 240)
p3 <- plotly_density_plotter(sd.purpose, index = "three", xlabel = "Miles to School", percent = T, tickvals = seq(1,50,5), ticktext = seq(0,50,5), height = 240)
	
bscols(widths=c(12),
  list(filter_select("Purpose_County", "Select District", sd.purpose, ~grp_var,multiple=F),
  p1,
  p2,
  p3)
  )

```


Flows & Tour Lengths{data-navmenu="Long Term"}
============================================

Description {.sidebar data-width=135}
--------------------------------------------

**County-County Flow of Workers**

Crosstab of workers by home county and usual work place county.

Note: Districts can be Tract, County, District etc.

**Average Tour Lengths**

Average tour length to workplace by District of residence



Chart Column 1
--------------------------------------------

###{data-height=300}
```{r Table1_CountyFlows}
cat("County - County Flow of Workers")

if(IS_BASE_SURVEY=="Yes"){
  base_df <- base_data[[which(base_csv_names=="countyFlowsCensus")]]
}else{
  base_df <- base_data[[which(base_csv_names=="countyFlows")]]
}

base_df[,!colnames(base_df) %in% c("X")] <- base_df[,!colnames(base_df) %in% c("X")]/BASE_SAMPLE_RATE
t1 <- kable(base_df, format = 'html', caption = DISTRICT_FLOW_CENSUS, digits = 0, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 10)
t1
```

### {data-height=280}
```{r Table1_MandTripLengths}
cat("Average Mandatory Tour Lengths")

base_df <- base_data[[which(base_csv_names=="mandTripLengths")]]
df <- base_df
colnames(df) <- c("Home District", "Work","University","School")

eval_expr <- paste("t1 <- kable(df, format = 'html', digits = 2, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 10, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BASE_SCENARIO_NAME, "' = 3))", sep = "")
eval(parse(text = eval_expr))
t1
```


Chart Column 1 
--------------------------------------------
###{data-height=300} 
```{r Table2_CountyFlows}
cat("County - County Flow of Workers")

build_pos <- which(build_csv_names=="countyFlows")
build_df <- build_data[[build_pos]]
build_df[,!colnames(build_df) %in% c("X")] <- build_df[,!colnames(build_df) %in% c("X")]/BUILD_SAMPLE_RATE
t2 <- kable(build_df, format = 'html', caption = BUILD_SCENARIO_NAME, digits = 0, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 10)
t2
```

###{data-height=280}
```{r Table2_MandTripLengths}
cat("Average Mandatory Tour Lengths")

build_df <- build_data[[which(build_csv_names=="mandTripLengths")]]
df <- build_df
colnames(df) <- c("Home District", "Work","University","School")

eval_expr <- paste("t2 <- kable(df, format = 'html', digits = 2, row.names = F, align = 'r', format.args = list(big.mark = ',')) %>%
  kable_styling('striped', font_size = 10, full_width=F, position='center') %>%
  add_header_above(c(' ' = 1, '", BUILD_SCENARIO_NAME, "' = 3))", sep = "")
eval(parse(text = eval_expr))
t2
```

Employment vs Workers{data-navmenu="Long Term"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Employment vs Workers comparison at MAZ level**

Results of work location model.

Comparison of assigned workers to available employment at MAZ level.

Only for build scenario.


Chart Column 2{.tabset}
--------------------------------------------

### Management{data-height=575}
```{r job_wrk1}

#knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "Jobs_Workers_Management.JPEG"))

```

### Professional{data-height=575}
```{r job_wrk2}

#knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "Jobs_Workers_Professional.JPEG"))

```

### Services{data-height=575}
```{r job_wrk3}

#knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "Jobs_Workers_Services.JPEG"))

```

### Retail{data-height=575}
```{r job_wrk4}

#knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "Jobs_Workers_Retail.JPEG"))

```

### Manual{data-height=575}
```{r job_wrk5}

#knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "Jobs_Workers_Manual.JPEG"))

```

### Military{data-height=575}
```{r job_wrk6}

#knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "Jobs_Workers_Military.JPEG"))

```

### Total{data-height=575}
```{r job_wrk7}

#knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "Jobs_Workers_Total.JPEG"))

```



Tour Summaries{data-navmenu="Tour Level"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

This page summarizes day-pattern and tour generation model results.

**Daily Activity Pattern**

Results of Coordinated Daily Activity Pattern (CDAP) model, summarized for each person.

_M_ : One or more mandatory tours

_N_ : No mandatory tours but one or more non-mandatory tours

_H_ : No tours (either home all day or out of area)

**Percentage of Households with Joint Tour**

Also the result of the CDAP model, summarized for each household.

**Mandatory Tour Frequency**

Result of the mandatory tour frequency model, summarized for each person with a daily activity pattern type _M_

**Tour rate by person type**

Summary of tours per person resulting from all tour generation models. Joint tours are counted for each participant.

**Individual non-mandatory tour frequency**

Results of individual non-mandatory tour frequency model, summarized for each person with a daily activity pattern type _M_ or _N_.

Chart Column 1 {data-width=160}
--------------------------------------------

### Daily Activity Pattern{data-height=500}
```{r Hist_DAP}
base_df <- base_data[[which(base_csv_names=="dapSummary_vis")]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)
base_df$DAP <- factor(base_df$DAP, levels = dap_types)
build_df <- build_data[[which(build_csv_names=="dapSummary_vis")]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)
build_df$DAP <- factor(build_df$DAP, levels = dap_types)

base_df$grp <- BASE_SCENARIO_NAME
build_df$grp <- BUILD_SCENARIO_NAME
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="DAP", y = c("freq"), grp = "PERNAME", shared = T)
p <- plotly_bar_plotter(data = sd.pertype, height = 250, xlabel = "DAP", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)

bscols(widths=c(3,9),
  list(
    filter_select("pertype_dap", "Select Person Type", sd.pertype, ~grp_var,multiple=F)),
    p
  )

```

### Percentage of Households with a Joint Tour{data-height=300}
```{r Hist_Presence_Joint}
base_pos <- which(base_csv_names=="hhsizeJoint")
base_df <- base_data[[base_pos]]
base_df <- base_df %>%
  group_by(HHSIZE) %>%
  mutate(percent = prop.table(freq)) %>%
  filter(JOINT==1) %>%
  ungroup()
build_pos <- which(build_csv_names=="hhsizeJoint")
build_df <- build_data[[build_pos]]
build_df <- build_df %>%
  group_by(HHSIZE) %>%
  mutate(percent = prop.table(freq)) %>%
  filter(JOINT==1) %>%
  ungroup()

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "HHSIZE", y = c("percent"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "HH Size", ylabel = "Percent of Households", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = F, tickformat = "%", hoverformat = ".1%")
p

```

### Mandatory Tour Frequency{data-height=500}
```{r Hist_MTF}
base_pos <- which(base_csv_names=="mtfSummary_vis")
base_df <- base_data[[base_pos]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)
base_df$mtf_name <- mtf_df$name[match(base_df$MTF, mtf_df$code)]
base_df$mtf_name <- factor(base_df$mtf_name, levels = mtf_names)
build_pos <- which(build_csv_names=="mtfSummary_vis")
build_df <- build_data[[build_pos]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)
build_df$mtf_name <- mtf_df$name[match(build_df$MTF, mtf_df$code)]
build_df$mtf_name <- factor(build_df$mtf_name, levels = mtf_names)
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="mtf_name", y = c("freq"), grp = "PERNAME", shared = T)
p <- plotly_bar_plotter(data = sd.pertype, height = 250, xlabel = "MTF Choice", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickangle = -30, bottom_offset = 50)

bscols(widths=c(3,9),
  list(
    filter_select("pertype_mtf", "Select Person Type", sd.pertype, ~grp_var,multiple=F)),
    p
  )

```

Chart Column 1 {data-width=150}
--------------------------------------------
### Total Tour Rate (only active Persons)
```{r Hist_totaltours}
base_df <- base_data[[which(base_csv_names=="total_tours_by_pertype_vis")]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)
base_df1 <- base_data[[which(base_csv_names=="activePertypeDistbn")]]
base_df$persons <- base_df1$freq[match(base_df$PERTYPE, base_df1$PERTYPE)]
base_df$tourrate <- round(base_df$freq/base_df$persons,2)

build_df <- build_data[[which(build_csv_names=="total_tours_by_pertype_vis")]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)
build_df1 <- build_data[[which(build_csv_names=="activePertypeDistbn")]]
build_df$persons <- build_df1$freq[match(build_df$PERTYPE, build_df1$PERTYPE)]
build_df$tourrate <- round(build_df$freq/build_df$persons,2)

colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "PERNAME", y = c("tourrate"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "Person Type", ylabel = "Tour Rate", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = F, height = 340, tickangle = -30, bottom_offset = 50)
p


```


### Persons by Individual Non-Mandatory Tours
```{r Hist_INM}
base_df <- base_data[[which(base_csv_names=="inmSummary_vis")]]
base_df$PERNAME <- person_type_df$name_char[match(base_df$PERTYPE, person_type_df$code)]
base_df$PERNAME <- factor(base_df$PERNAME, levels = person_type_char)

build_df <- build_data[[which(build_csv_names=="inmSummary_vis")]]
build_df$PERNAME <- person_type_df$name_char[match(build_df$PERTYPE, person_type_df$code)]
build_df$PERNAME <- factor(build_df$PERNAME, levels = person_type_char)

colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="nmtours", y = c("freq"), grp = "PERNAME", shared = T)
#p <- plotly_bar_plotter(data = sd.pertype, height = 340, xlabel = "Number of Tours", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, #BUILD_SCENARIO_NAME), percent = T, tickvals = c(seq(0,2), "3pl"), ticktext = c("0", "1", "2", "3pl"))

p <- plotly_bar_plotter(data = sd.pertype, height = 340, xlabel = "Number of Tours", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)

bscols(widths=c(3,9),
  list(
    filter_select("pertype_mtf", "Select Person Type", sd.pertype, ~grp_var,multiple=F)),
    p
  )


```



Joint Tours{data-navmenu="Tour Level"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

********

This page tabulates the results of the Joint Tour Frequency and Composition Model and the Joint Tour Person Participation Model.

**Joint Tour Frequency**

The frequency of households by number and purpose of joint tours.

**Joint Tour Composition**

The frequency of tours by composition (Adults only, Children only, Adults + Children).

**Joint Tour Party Size**

The frequency of joint tours by the number of household members participating in the tour.

**Joint Tours by HH Size**

The frequency of households by household size and the number of joint tours per household.

**Joint Tours by HH Size**

_Tour Level_

Distribution of joint tours by party size for each composition type.


Chart Column 1 {data-width=150}
--------------------------------------------
### Joint Tour Frequency{data-height=675}
```{r jtf}
base_df <- base_data[[which(base_csv_names=="jtf")]]
build_df <- build_data[[which(build_csv_names=="jtf")]]
# remove no joint tours option
base_df <- base_df[-1,]
build_df <- build_df[-1,]
colnames(build_df) <- colnames(base_df)

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "alt_name", y = c("freq"))
std_DF$xvar <- factor(std_DF$xvar, levels = jtf_alternatives)

p <- plotly_bar_plotter(data = std_DF, xlabel = "Joint Tour Combination", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, height = 500, bottom_offset = 275, tickangle = 300)
p

```

### Joint Tour Composition
```{r jtf_comp}
base_df <- base_data[[which(base_csv_names=="jointComp")]]
names(base_df)[names(base_df)=="tour_composition"] <- "COMPOSITION"
build_df <- build_data[[which(build_csv_names=="jointComp")]]
colnames(build_df) <- colnames(base_df)

p1 <- plotly_pie_chart(data = base_df, label_var = "COMPOSITION", value_var = "freq", height = 250, title = BASE_SCENARIO_NAME, top_offset = 50)
p2 <- plotly_pie_chart(data = build_df, label_var = "COMPOSITION", value_var = "freq", height = 250, title = BUILD_SCENARIO_NAME, top_offset = 50)

bscols(widths=c(6,6),
  p1,
  p2
  )
```

Chart Column 1 {data-width=150}
--------------------------------------------

### Joint Tours By Number of Household Members
```{r jtf_partysize}
base_df <- base_data[[which(base_csv_names=="jointPartySize")]]
build_df <- build_data[[which(build_csv_names=="jointPartySize")]]
colnames(build_df) <- colnames(base_df)

build_df$freq[build_df$NUMBER_HH==5] <- sum(build_df$freq[build_df$NUMBER_HH>=5])
build_df <- build_df[build_df$NUMBER_HH<=5, ]

std_DF <- get_standardDF(data_df1 = base_df, data_df2 = build_df, x = "NUMBER_HH", y = c("freq"))
p <- plotly_bar_plotter(data = std_DF, xlabel = "Joint Party Size", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, height = 200)
p

```

### Joint Tours by Household Size
```{r jtf_byhhsize}
base_pos <- which(base_csv_names=="jointToursHHSize")
base_df <- base_data[[base_pos]]

build_pos <- which(build_csv_names=="jointToursHHSize")
build_df <- build_data[[build_pos]]
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="jointTours", y = c("freq"), grp = "hhsize", shared = T)
p <- plotly_bar_plotter(data = sd.pertype, height = 225, xlabel = "Number of Joint Tours", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)

bscols(widths=c(3,9),
  list(
    filter_select("jtf_hhsize", "Select HH Size Group", sd.pertype, ~grp_var,multiple=F)),
    p
  )

```

### Party Size Distribution by Joint Tour Composition
```{r jtf_comppartysize}
base_df <- base_data[[which(base_csv_names=="jointCompPartySize")]]
build_df <- build_data[[which(build_csv_names=="jointCompPartySize")]]
colnames(build_df) <- colnames(base_df)

sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="partysize", y = c("freq"), grp = "comp", shared = T)
p <- plotly_bar_plotter(data = sd.pertype, height = 225, xlabel = "Joint Party Size", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)

bscols(widths=c(3,9),
  list(
    filter_select("jtf_comp", "Select Party Composition", sd.pertype, ~grp_var,multiple=F)),
    p
  )

```




Destination{data-navmenu="Tour Level"}
============================================

Description {.sidebar data-width=225}
--------------------------------------------

********

**Non-Mandatory Tour Length Distribution**

Results of non-mandatory tour destination choice models. 

Distribution of tours by distance between tour origin and destination for each non-mandatory tour purpose.


Chart Column 1 {data-width=100}
--------------------------------------------
### Non-Mandatory Tour Length Distribution{data-height=350}
```{r nm_tlfd}
base_df <- base_data[[which(base_csv_names=="tourDistProfile_vis")]]
build_df <- build_data[[which(build_csv_names=="tourDistProfile_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$PURPOSE <- as.character(base_df$PURPOSE)
build_df$PURPOSE <- as.character(build_df$PURPOSE)
base_df$PURPOSE <- purpose_type_df$name[match(base_df$PURPOSE, purpose_type_df$code)]
build_df$PURPOSE <- purpose_type_df$name[match(build_df$PURPOSE, purpose_type_df$code)]

sd.purpose <- get_sharedData(data_df1 = base_df, data_df2 = build_df, run1_name = BASE_SCENARIO_NAME, 
                             run2_name = BUILD_SCENARIO_NAME, x = "distbin", y = c("freq"), grp = "PURPOSE")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Miles", percent = T, 
                             tickvals = seq(2,41), ticktext = c(seq(1,40), "40pl"))
bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  p1
  )
```

### Average Non-Mandatory Tour Lengths (Miles){data-height=250}
```{r Table1_nonMandTripLength}
base_df <- base_data[[which(base_csv_names=="nonMandTripLengths")]]
build_df <- build_data[[which(build_csv_names=="nonMandTripLengths")]]
df <- data.frame(base_df, build_df[,-1])
colnames(df) <- c("Purpose", BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME)
df$Purpose <- purpose_type_df$name[match(df$Purpose, purpose_type_df$code)]

t1 <- kable(df, format = "html", digits = 2, row.names = F, align = 'c', format.args = list(big.mark = ',')) %>%
  kable_styling("striped", full_width = F)
t1
```


TOD {data-navmenu="Tour Level"}
============================================

Description {.sidebar data-width=200}
--------------------------------------------

********

**Tour Departure Arrival & Duration**

Tour Time-of-day Choice Model results.

Each tour is assigned a time period of departure (time leaving home or work) and arrival (time arriving back at home or work). The entire day is divided into 40 half-hour bins (the first bin includes 3:00 AM to 5:00 AM and the last bin includes 12:00 PM to 3:00 AM).

Tour duration is calculated as a function of departure and arrival period. It includes travel time and time spent at the primary destination and all intermediate stops.

Results are shown for tours, filtered by tour purpose.

********

**Aggregate Tour Arrival-Departure**

_EA_: 3:00 AM to 6:00 AM

_AM_: 6:00 AM to 9:00 AM

_MD_: 9:00 AM to 3:30 PM

_PM_: 3:30 PM to 7:00 PM

_EV_: 7:00 PM to 3:00 AM

Chart Column 1 {.tabset}
--------------------------------------------
### Tour Departure-Arrival Profile
```{r tour_tod}
base_df <- base_data[[which(base_csv_names=="todProfile_vis")]]
base_df$tod_bin <- tod_df$bin[match(base_df$id, tod_df$id)]
base_df$dur_bin <- dur_df$bin[match(base_df$id, dur_df$id)]
build_df <- build_data[[which(build_csv_names=="todProfile_vis")]]
build_df$tod_bin <- tod_df$bin[match(build_df$id, tod_df$id)]
build_df$dur_bin <- dur_df$bin[match(build_df$id, dur_df$id)]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]

sd.purpose <- get_sharedData(data_df1 = base_df, data_df2 = build_df, run1_name = BASE_SCENARIO_NAME, 
                             run2_name = BUILD_SCENARIO_NAME, x = "id", y = c("freq_dep", "freq_arr", "freq_dur"), grp = "purpose")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Tour Departure", percent = T, left_offset = 25, 
                             tickvals = seq(1,40), ticktext = todBins, bottom_offset = 150, tickangle = 315, height = 275)
p2 <- plotly_density_plotter(sd.purpose, index = "two", xlabel = "Tour Arrival", percent = T, left_offset = 25, 
                             tickvals = seq(1,40), ticktext = todBins, bottom_offset = 150, tickangle = 315, height = 275)
p3 <- plotly_density_plotter(sd.purpose, index = "three", xlabel = "Tour Duraction", percent = T, left_offset = 25, 
                             tickvals = seq(1,40), ticktext = durBins, bottom_offset = 50, tickangle = 315, height = 225)
	
bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  list(p1, p2, p3)
  )


```

### Tour Aggregate Departure-Arrival Profile
```{r tour_tod_agg}
base_df <- base_data[[which(base_csv_names=="todProfile_vis")]]
base_df$tod_agg <- cut(base_df$id, breaks = timePeriodBreaks, labels = timePeriods, right = FALSE)
base_df <- base_df %>%
  group_by(purpose, tod_agg) %>%
  summarise(freq_dep = sum(freq_dep), freq_arr = sum(freq_arr), freq_dur = sum(freq_dur)) %>%
  ungroup()

build_df <- build_data[[which(build_csv_names=="todProfile_vis")]]
build_df$tod_agg <- cut(build_df$id, breaks = timePeriodBreaks, labels = timePeriods, right = FALSE)
build_df <- build_df %>%
  group_by(purpose, tod_agg) %>%
  summarise(freq_dep = sum(freq_dep), freq_arr = sum(freq_arr), freq_dur = sum(freq_dur)) %>%
  ungroup()
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]

sd.purpose <- get_standardDF(data_df1=base_df, data_df2=build_df, x="tod_agg", y = c("freq_dep", "freq_arr", "freq_dur"), grp = "purpose", shared = T)

p1 <- plotly_bar_plotter(data = sd.purpose, height = 350, xlabel = "Tour Departure", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)
p2 <- plotly_bar_plotter(data = sd.purpose, height = 350, xlabel = "Tour Arrival", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, index = 2)

bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  list(p1, p2)
  )


```



Tour Mode{data-navmenu="Tour Level"}
============================================


Chart Column 1{data-width=150}
--------------------------------------------


### Tour Mode Choice
```{r tourMode}
base_df <- base_data[[which(base_csv_names=="tmodeProfile_vis")]]
base_df$purpose <- as.character(base_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df <- build_data[[which(build_csv_names=="tmodeProfile_vis")]]
build_df$purpose <- as.character(build_df$purpose)
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]
colnames(build_df) <- colnames(base_df)


sd.pertype <- get_standardDF(data_df1=base_df, data_df2=build_df, x="id", y = c("freq_as0", "freq_as1", "freq_as2", "freq_all"), grp = "purpose", shared = T)
p1 <- plotly_bar_plotter(data = sd.pertype, height = 375, xlabel = "Tour Mode [Zero Auto]", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tourMode, bottom_offset = 55, tickangle = 300)
p2 <- plotly_bar_plotter(data = sd.pertype, height = 375, xlabel = "Tour Mode [Autos < Workers]", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tourMode, index = 2, bottom_offset = 55, tickangle = 300)
p3 <- plotly_bar_plotter(data = sd.pertype, height = 375, xlabel = "Tour Mode [Autos >= Workers]", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tourMode, index = 3, bottom_offset = 55, tickangle = 300)
p4 <- plotly_bar_plotter(data = sd.pertype, height = 375, xlabel = "Tour Mode [Total]", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tourMode, index = 4, bottom_offset = 55, tickangle = 300)

filter_select("tourMode", "Select Tour Purpose", sd.pertype, ~grp_var,multiple=F)

```

********


**Tour Mode Choice**

Results of Tour Mode Choice Models, which selects a primary mode for each tour. 

Distribution of tours by tour mode and the ratio of autos to drivers in the household.


Chart Column 2 {data-width=400}
--------------------------------------------

### 
```{r tourMode2}
bscols(widths=c(12),
  list(p1,p2)
  )
```

Chart Column 3 {data-width=400}
--------------------------------------------

### 
```{r tourMode3}
bscols(widths=c(12),
  list(p3,p4)
  )
```


Stop Frequency {data-navmenu="Trip Level"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Stop Frequency**

Results of the Intermediate Stop Frequency Model, which predicts the number of intermediate stops on each tour by tour direction (outbound versus inbound).

The summary shows percent of tours by number of stops on the tour and tour direction.

**Stop Purpose**

Results of the Intermediate Stop Purpose Model, which is currently implemented as a Monte Carlo choice according to probability distributions generated from survey data.

The summary shows the percent of intermediate stops by stop purpose and tour purpose.

Chart Column 1 {data-width=200}
--------------------------------------------
### Stop Frequency - Directional
```{r stopfreq_dir}
base_df <- base_data[[which(base_csv_names=="stopfreqDir_vis")]]
build_df <- build_data[[which(build_csv_names=="stopfreqDir_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.pertype1 <- get_standardDF(data_df1=base_df, data_df2=build_df, x="nstops", y = c("freq_out", "freq_inb"), grp = "purpose", shared = T)
p1 <- plotly_bar_plotter(data = sd.pertype1, height = 325, xlabel = "Number of Stops - Outbound", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,4), ticktext = c("0", "1", "2", "3pl"))
p2 <- plotly_bar_plotter(data = sd.pertype1, height = 325, xlabel = "Number of Stops - Inbound", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,4), ticktext = c("0", "1", "2", "3pl"), index = 2)
bscols(widths=c(12),
  list(
    filter_select("stopfreq_dir", "Select Tour Purpose", sd.pertype1, ~grp_var,multiple=F), 
    p1, 
    p2)
  )

```



Chart Column 1 {data-width=300}
--------------------------------------------
### Stop Frequency - Total{data-height=250}
```{r stopfreq_total}
base_df <- base_data[[which(base_csv_names=="stopfreq_total_vis")]]
build_df <- build_data[[which(build_csv_names=="stopfreq_total_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.pertype2 <- get_standardDF(data_df1=base_df, data_df2=build_df, x="nstops", y = c("freq"), grp = "purpose", shared = T)
p1 <- plotly_bar_plotter(data = sd.pertype2, height = 350, xlabel = "Number of Stops", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,7), ticktext = c("0", "1", "2", "3", "4", "5", "6pl"))

bscols(widths=c(3,9),
  list(
    filter_select("stopfreq_total", "Select Tour Purpose", sd.pertype2, ~grp_var,multiple=F)),
    p1
  )
```

### Stop Purpose by Tour Purpose{data-height=250}
```{r stoppurp_tourpurp}
base_df <- base_data[[which(base_csv_names=="stoppurpose_tourpurpose_vis")]]
build_df <- build_data[[which(build_csv_names=="stoppurpose_tourpurpose_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.pertype3 <- get_standardDF(data_df1=base_df, data_df2=build_df, x="stop_purp", y = c("freq"), grp = "purpose", shared = T)
p1 <- plotly_bar_plotter(data = sd.pertype3, height = 350, xlabel = "Stop Purpose", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,10), ticktext = stopPurposes)

bscols(widths=c(3,9),
  list(
    filter_select("stoppurp_tourpurp", "Select Tour Purpose", sd.pertype3, ~grp_var,multiple=F)),
    p1
  )

```


Location{data-navmenu="Trip Level"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Stop Location**

Results of the Intermediate Stop Location Choice Model, which predicts the location of each intermediate stop.

The summary shows the distribution of intermediate stops by out of direction distance and tour purpose.

Out of direction distance is defined as the extra distance to the destination as a result of traveling through the stop location. 
For stops in the outbound direction, it is based on the distance between the last known location (the tour origin or previous outbound stop) and the tour primary destination.
For stops in the inbound direction, it is based on the distance between the last known location (the tour primary destination or previous inbound stop) and the tour origin.

Chart Column 1 {data-width=800}
--------------------------------------------

### Stop Location - Out of Direction Distance{data-height=350}
```{r stopDC}
base_df <- base_data[[which(base_csv_names=="stopDC_vis")]]
build_df <- build_data[[which(build_csv_names=="stopDC_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$PURPOSE <- as.character(base_df$PURPOSE)
build_df$PURPOSE <- as.character(build_df$PURPOSE)
base_df$PURPOSE <- purpose_type_df$name[match(base_df$PURPOSE, purpose_type_df$code)]
build_df$PURPOSE <- purpose_type_df$name[match(build_df$PURPOSE, purpose_type_df$code)]


sd.purpose <- get_sharedData(data_df1 = base_df, data_df2 = build_df, run1_name = BASE_SCENARIO_NAME, 
                             run2_name = BUILD_SCENARIO_NAME, x = "distbin", y = c("freq"), grp = "PURPOSE")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Out of Direction Distance (Miles)", percent = T, left_offset = 25, 
                             tickvals = seq(1,42), ticktext = outDirDist, height = 600, tickangle = 300, bottom_offset = 50)
bscols(widths=c(12),
  list(
    filter_select("stopDC", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F), p1)
  )
```

Chart Column 1 {data-width=300}
--------------------------------------------

### Average Out of Direction Distance (Miles){data-height=250}
```{r Table1_outOfDir}
base_df <- base_data[[which(base_csv_names=="avgStopOutofDirectionDist_vis")]]
build_df <- build_data[[which(build_csv_names=="avgStopOutofDirectionDist_vis")]]
df <- data.frame(base_df, build_df[,-1])
colnames(df) <- c("Tour_Purpose", BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME)
df$Tour_Purpose <- purpose_type_df$name[match(df$Tour_Purpose, purpose_type_df$code)]
#
#t1 <- kable(df, format = "html", digits = 2, row.names = F, align = 'c', format.args = list(big.mark = ',')) %>%
#  kable_styling("striped", full_width = F)

t1 <- htmlTable(txtRound(df, 2), 
                align = "c|r",
                rnames = F,
                col.columns = c(rep("#E6E6F0", 1),
                          rep("none", ncol(df) - 1)), 
                caption = "_______________________________________________________")

t1
```


TOD{data-navmenu="Trip Level"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Stop Departure**

Results of the Stop Departure Time Choice Model. The departure time of each stop on the tour is currently implemented as a Monte Carlo choice of time period from distributions generated from survey data.

The entire day is divided into 40 half-hour bins (The first bin includes 3:00 AM to 5:00 AM and the last bin includes 12:00 PM to 3:00 AM).

**Trip Departure**

Summarizes all trips by departure time period, including trips to and from intermediate stops and the tour primary destination.

Chart Column 1 {.tabset}
--------------------------------------------

### Stop & Trip Departure{data-height=650}
```{r stopDep}
base_df <- base_data[[which(base_csv_names=="stopTripDep_vis")]]
build_df <- build_data[[which(build_csv_names=="stopTripDep_vis")]]
colnames(base_df) <- c("timebin", "purpose", "freq_stop", "freq_trip")
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.purpose <- get_sharedData(data_df1 = base_df, data_df2 = build_df, run1_name = BASE_SCENARIO_NAME, 
                             run2_name = BUILD_SCENARIO_NAME, x = "timebin", y = c("freq_stop", "freq_trip"), grp = "purpose")

p1 <- plotly_density_plotter(sd.purpose, index = "one", xlabel = "Stop Departure", percent = T, left_offset = 25,
                             tickvals = seq(1,40), ticktext = todBins, bottom_offset = 150, tickangle = 315, height = 400)
p2 <- plotly_density_plotter(sd.purpose, index = "two", xlabel = "Trip Departure", percent = T, left_offset = 25, 
                             tickvals = seq(1,40), ticktext = todBins, bottom_offset = 150, tickangle = 315, height = 400)
#p3 <- datatable(sd.purpose$data())
bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  list(p1, p2)
  )
```

### Aggregate Stop & Trip Departure
```{r trip_tod_agg}
base_df <- base_data[[which(base_csv_names=="stopTripDep_vis")]]
colnames(base_df) <- c("id","purpose","freq_stop","freq_trip")
base_df$tod_agg <- cut(base_df$id, breaks = timePeriodBreaks, labels = timePeriods, right = FALSE)
base_df <- base_df %>%
  group_by(purpose, tod_agg) %>%
  summarise(freq_stop = sum(freq_stop), freq_trip = sum(freq_trip)) %>%
  ungroup()

build_df <- build_data[[which(build_csv_names=="stopTripDep_vis")]]
colnames(build_df) <- c("id","purpose","freq_stop","freq_trip")
build_df$tod_agg <- cut(build_df$id, breaks = timePeriodBreaks, labels = timePeriods, right = FALSE)
build_df <- build_df %>%
  group_by(purpose, tod_agg) %>%
  summarise(freq_stop = sum(freq_stop), freq_trip = sum(freq_trip)) %>%
  ungroup()
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]

sd.purpose <- get_standardDF(data_df1=base_df, data_df2=build_df, x="tod_agg", y = c("freq_stop", "freq_trip"), grp = "purpose", shared = T)

p1 <- plotly_bar_plotter(data = sd.purpose, height = 350, xlabel = "Stop Departure", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T)
p2 <- plotly_bar_plotter(data = sd.purpose, height = 350, xlabel = "Trip Departure", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, index = 2)

bscols(widths=c(2,10),
  filter_select("Tour Purpose", "Select Tour Purpose", sd.purpose, ~grp_var,multiple=F),
  list(p1, p2)
  )


```



Trip Mode{data-navmenu="Trip Level"}
============================================



Chart Column 1 {data-width=125}
--------------------------------------------

###  {data-height=200}

***Trip Mode Choice***

The results of the Trip Mode Choice Model, which predicts the mode of each trip on the tour.

Distribution of trips by trip mode and tour mode, which constrains the availability of each trip mode and influences the utility of each available trip mode.

### Trip Mode Choice
```{r tripMode}
base_df <- base_data[[which(base_csv_names=="tripModeProfile_vis")]]
build_df <- build_data[[which(build_csv_names=="tripModeProfile_vis")]]
colnames(build_df) <- colnames(base_df)

# change purpose names to standard format
base_df$purpose <- as.character(base_df$purpose)
build_df$purpose <- as.character(build_df$purpose)
base_df$purpose <- purpose_type_df$name[match(base_df$purpose, purpose_type_df$code)]
build_df$purpose <- purpose_type_df$name[match(build_df$purpose, purpose_type_df$code)]


sd.purpose <- get_standardDF(data_df1=base_df, data_df2=build_df, x="tripmode", y = c("value"), grp = "grp_var", shared = T)

p <- plotly_bar_plotter(data = sd.purpose, height = 700, xlabel = "Trip Mode", ylabel = "Percent", ynames = c(BASE_SCENARIO_NAME, BUILD_SCENARIO_NAME), percent = T, tickvals = seq(1,9), ticktext = tripMode, bottom_offset = 75)

bscols(widths=c(12),
  list(filter_select("tripMode1", "Select Tour Purpose", sd.purpose, ~purpose,multiple=F), 
       filter_select("tripMode1", "Select Tour Mode", sd.purpose, ~tourmode,multiple=F))
  )
```

Chart Column 2 {data-width=800}
--------------------------------------------
###
```{r tripMode2}
bscols(widths=c(12),
  list(p)
  )

```

Count vs Volume: All Day{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### Count vs Volume - All Links{data-height=575}
```{r count_vol2}


```

### Gap Statistics{data-height=575}
```{r count_vol3}


```

Count vs Volume: EA{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### EA Count vs Volume - All Links{data-height=575}
```{r count_vol4}

```

### EA Gap Statistics{data-height=575}
```{r count_vol5}


```

Count vs Volume: AM{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### AM Count vs Volume - All Links{data-height=575}
```{r count_vol6}

```

### AM Gap Statistics{data-height=575}
```{r count_vol7}


```

Count vs Volume: MD{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### MD Count vs Volume - All Links{data-height=575}
```{r count_vol8}

```

### MD Gap Statistics{data-height=575}
```{r count_vol9}


```

Count vs Volume: PM{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### PM Count vs Volume - All Links{data-height=575}
```{r count_vol10}

```

### PM Gap Statistics{data-height=575}
```{r count_vol11}


```

Count vs Volume: EV{data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### EV Count vs Volume - All Links{data-height=575}
```{r count_vol12}

```

### EV Gap Statistics{data-height=575}
```{r count_vol13}


```

MTC vs MARIN {data-navmenu="Assignment"}
============================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**Link level count comparison**

Results of auto assignment.

Comparison of observed counts and assigned volumes on each link with a counted volume, by assignment time period.


Chart Column 2{.tabset}
--------------------------------------------

### Volume Comparison - Daily{data-height=575}
```{r count_vol14}

knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "assign_summary_Daily.jpeg"))
```

### Volume Comparison - EA{data-height=575}
```{r count_vol15}

knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "assign_summary_EA.jpeg"))
```

### Volume Comparison - AM{data-height=575}
```{r count_vol16}

knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "assign_summary_AM.jpeg"))
```

### Volume Comparison - MD{data-height=575}
```{r count_vol17}

knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "assign_summary_MD.jpeg"))
```

### Volume Comparison - PM{data-height=575}
```{r count_vol18}

knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "assign_summary_PM.jpeg"))
```

### Volume Comparison - EV{data-height=575}
```{r count_vol19}

knitr::include_graphics(file.path(SYSTEM_JPEG_PATH, "assign_summary_EV.jpeg"))
```


Non-Mandatory Trip Flows{data-navmenu="District Summaries"}
=========================================================

Description {.sidebar data-width=175}
--------------------------------------------

********

**District level flow comparison**

Results of district summaries.

Comparison of non-mandatory district flow summaries.

Chart Column 2{.tabset}
--------------------------------------------

### TLFD by District{data-height=575}
```{r DFLOW_dis1}


```

### TLFD by District{data-height=575}
```{r DFLOW_dis2}


```